home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / Hack / MISC / MAGCARD4.ZIP / MAGCARD4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-10  |  10.7 KB  |  348 lines
  1. {
  2. *****************************************************************************
  3. * Magnetic Strip Card Reader for PC Compatible Computers using the LPT Port *
  4. * and the Mitsubishi M54914/M56710 series of F2F decoder circuits. This     *
  5. * program is Public Domain and may be copied & used freely by anyone who    *
  6. * wants to. Connect the card reader chip to the PC LPT port like this:      *
  7. *                                                                           *
  8. * (See the data sheet for the Mitsubishi M54914/M56710 Chip for more info!) *
  9. *                                                                           *
  10. *       CLS ---> LPT Pin 13    = Orange                                     *
  11. *       RCP ---> LPT Pin 12    = Red                                        *
  12. *       RDT ---> LPT Pin 11    = Brown                                      *
  13. *       +5V ---> LPT Pin 02-09 = Yellow                                     *
  14. *       GND ---> LPT Pin 25    = Green                                      *
  15. *                                                                           *
  16. *****************************************************************************
  17. }
  18.  
  19. Program Magstrip_Read;
  20.  
  21.     Uses Crt, Dos;
  22.  
  23.     Type        Smallarray1=Array[1..16] of Byte;
  24.                 SmallArray2=Array[1..16] of Char;
  25.                 SmallArray3=Array[1..64] of Byte;
  26.                 SmallArray4=Array[1..64] of Char;
  27.  
  28.     Const       ISO_BCD1:SmallArray1=($01,$10,$08,$19,$04,$15,$0d,$1c,$02,$13,$0b,$1a,$07,$16,$0e,$1f);
  29.                 ISO_BCD2:SmallArray2=('0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?');
  30.                 ISO_ALP1:SmallArray3=($01,$40,$20,$61,$10,$51,$31,$70,$08,$49,$29,$68,$19,$58,$38,
  31.                 $79,$04,$45,$25,$64,$15,$54,$34,$75,$0d,$4c,$2c,$6d,$1c,$5d,$3d,$7c,$02,$43,$23,$62,
  32.                 $13,$52,$32,$73,$0b,$4a,$2a,$6b,$1a,$5b,$3b,$7a,$07,$46,$26,$67,$16,$57,$37,$76,$0e,
  33.                 $4f,$2f,$6e,$1f,$5e,$3e,$7f);
  34.                 ISO_ALP2:SmallArray4=(' ','!','"','#','$','%','&',chr(39),'(',')','*','+',',','-','.',
  35.                 '/','0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?','@','A','B','C','D',
  36.                 'E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  37.                 '[','\',']','~','_');
  38.     Var
  39.                 Card_Bin:Array[1..4096] of Byte;
  40.                 Card_BCD:Array[1..128] of Byte;
  41.                 Card_Par:Array[1..128] of Boolean;
  42.                 Card_ASC:Array[1..128] of Char;
  43.                 Tbyte,ISO,Par_Chk,Par_Clc:Byte;
  44.                 X,Y,Z,Bitcount,Ch_Count,Chstart,LPT:Integer;
  45.                 Eflag,P_Err:Boolean;
  46.                 Fpnt:Text;
  47.                 Fpnt2:Text;
  48.                 Key:Char;
  49.  
  50. Procedure Cardwait;
  51.  
  52. begin;
  53.     repeat
  54.     until port[LPT+1] and 16=0;
  55. end;
  56.  
  57. Function Cardread:Integer;
  58.  
  59. Var X,Bitcount:Integer;
  60.  
  61. Begin;
  62.      X:=1;
  63.      repeat
  64.            repeat
  65.                  If port[LPT+1] and 16=16 then break;
  66.            until port[LPT+1] and 32=0;
  67.            If port[LPT+1] and 128=128 then begin
  68.                  Card_Bin[X]:=1;
  69.            end;
  70.            If port[LPT+1] and 128=0 then begin;
  71.                  Card_Bin[X]:=0;
  72.            end;
  73.            repeat
  74.                  If port[LPT+1] and 16=16 then break;
  75.            until port[LPT+1] and 32=32;
  76.            Bitcount:=X;
  77.            X:=X+1;
  78.      until port[LPT+1] and 16=16;
  79.      Cardread:=Bitcount;
  80. end;
  81.  
  82. Function CardType:Byte;
  83.  
  84. Var   Tbyte:Byte;
  85.       X:Integer;
  86.  
  87. Begin;
  88.       Tbyte:=0;
  89.       For X:=1 to Bitcount do begin
  90.           Tbyte:=Tbyte Shl 1;
  91.           If Card_Bin[X]=1 then Tbyte:=Tbyte or 1;
  92.           If (Tbyte and $1f)=$1a then begin;
  93.              Chstart:=(X-4);
  94.              Cardtype:=$1a;
  95.              Break;
  96.           end;
  97.           If (Tbyte and $7f)=$51 then begin;
  98.              Chstart:=(X-6);
  99.              Cardtype:=$51;
  100.              Break;
  101.           end;
  102.       end;
  103. end;
  104.  
  105. Procedure ISO_BCD_2_ASC;
  106.  
  107. Var       X,Y,Z:Integer;
  108.           Tbyte,P_Chk2,P_Chk3,P_Chk4,P_Chk5:Byte;
  109.           Eflag:Boolean;
  110.  
  111. Begin;
  112.       Z:=1;
  113.       Y:=Chstart;
  114.       Eflag:=False;
  115.       repeat
  116.            If Tbyte=$1f then Eflag:=True;
  117.            Tbyte:=0;
  118.            For X:=1 to 5 do begin
  119.                Tbyte:=Tbyte Shl 1;
  120.                If Card_Bin[Y]=1 then begin;
  121.                   Tbyte:=Tbyte or 1;
  122.                end;
  123.                inc(y);
  124.                If Y>Bitcount then break;
  125.            end;
  126.            Card_BCD[Z]:=Tbyte;
  127.            Z:=Z+1;
  128.            If Y>Bitcount then break;
  129.        until Eflag=True;
  130.        Ch_Count:=Z-1;
  131.        Par_Chk:=Card_BCD[Z-1];
  132.        P_Err:=False;
  133.        For X:=1 to Ch_Count do begin;
  134.            Tbyte:=Card_BCD[X];
  135.            Y:=0;
  136.            For Z:=1 to 5 do begin;
  137.                Y:=Y+(Tbyte and 1);
  138.                Tbyte:=Tbyte Shr 1;
  139.            end;
  140.            If Y and 1<>0 then Card_Par[X]:=False
  141.            Else Card_Par[X]:=True;
  142.        end;
  143.            P_Chk5:=0;
  144.            P_Chk4:=0;
  145.            P_Chk3:=0;
  146.            P_Chk2:=0;
  147.        For X:=1 to Ch_Count-1 do begin;
  148.            Tbyte:=Card_BCD[X];
  149.            If Tbyte and 16<>0 then inc(P_Chk5);
  150.            If Tbyte and 8<>0 then inc(P_Chk4);
  151.            If Tbyte and 4<>0 then inc(P_Chk3);
  152.            If Tbyte and 2<>0 then inc(P_Chk2);
  153.        end;
  154.        Tbyte:=0;
  155.        If P_Chk5 and 1<>0 then Tbyte:=Tbyte or 16;
  156.        If P_Chk4 and 1<>0 then Tbyte:=Tbyte or 8;
  157.        If P_Chk3 and 1<>0 then Tbyte:=Tbyte or 4;
  158.        If P_Chk2 and 1<>0 then Tbyte:=Tbyte or 2;
  159.        Par_Clc:=Tbyte;
  160.        Z:=0;
  161.        For X:=1 to 5 do begin;
  162.            Z:=Z+(Tbyte and 1);
  163.            Tbyte:=Tbyte shr 1;
  164.        end;
  165.        If (Z and 1)=0 then Par_Clc:=Par_Clc or 1;
  166.        If Par_Chk<>Par_Clc then P_Err:=True;
  167.        Z:=0;
  168.        repeat
  169.              X:=0;
  170.              inc(z);
  171.              repeat
  172.                    inc(x);
  173.                    If (Card_BCD[Z] and $1e=ISO_BCD1[X] and $1e) then begin
  174.                       Card_ASC[Z]:=ISO_BCD2[X];
  175.                       Break;
  176.                    end;
  177.              until X>16;
  178.        until Z=Ch_Count;
  179. end;
  180.  
  181. Procedure ISO_ALP_2_ASC;
  182.  
  183. Var       X,Y,Z:Integer;
  184.           Tbyte,P_Chk2,P_Chk3,P_Chk4,P_Chk5,P_Chk6,P_Chk7:Byte;
  185.           Eflag:Boolean;
  186.  
  187. Begin;
  188.       Z:=1;
  189.       Y:=Chstart;
  190.       Eflag:=False;
  191.       repeat
  192.            If Tbyte=$7c then Eflag:=True;
  193.            Tbyte:=0;
  194.            For X:=1 to 7 do begin
  195.                Tbyte:=Tbyte Shl 1;
  196.                If Card_Bin[Y]=1 then begin;
  197.                   Tbyte:=Tbyte or 1;
  198.                end;
  199.                inc(y);
  200.                If Y>Bitcount then break;
  201.            end;
  202.            Card_BCD[Z]:=Tbyte;
  203.            Z:=Z+1;
  204.            If Y>Bitcount then break;
  205.        until Eflag=True;
  206.        Ch_Count:=Z-1;
  207.        Par_Chk:=Card_BCD[Z-1];
  208.        P_Err:=False;
  209.        For X:=1 to Ch_Count do begin;
  210.            Tbyte:=Card_BCD[X];
  211.            Y:=0;
  212.            For Z:=1 to 7 do begin;
  213.                Y:=Y+(Tbyte and 1);
  214.                Tbyte:=Tbyte Shr 1;
  215.            end;
  216.            If Y and 1<>0 then Card_Par[X]:=False
  217.            Else Card_Par[X]:=True;
  218.        end;
  219.            P_Chk7:=0;
  220.            P_Chk6:=0;
  221.            P_Chk5:=0;
  222.            P_Chk4:=0;
  223.            P_Chk3:=0;
  224.            P_Chk2:=0;
  225.        For X:=1 to Ch_Count-1 do begin;
  226.            Tbyte:=Card_BCD[X];
  227.            If Tbyte and 64<>0 then inc(P_Chk7);
  228.            If Tbyte and 32<>0 then inc(P_Chk6);
  229.            If Tbyte and 16<>0 then inc(P_Chk5);
  230.            If Tbyte and 8<>0 then inc(P_Chk4);
  231.            If Tbyte and 4<>0 then inc(P_Chk3);
  232.            If Tbyte and 2<>0 then inc(P_Chk2);
  233.        end;
  234.        Tbyte:=0;
  235.        If P_Chk7 and 1<>0 then Tbyte:=Tbyte or 64;
  236.        If P_Chk6 and 1<>0 then Tbyte:=Tbyte or 32;
  237.        If P_Chk5 and 1<>0 then Tbyte:=Tbyte or 16;
  238.        If P_Chk4 and 1<>0 then Tbyte:=Tbyte or 8;
  239.        If P_Chk3 and 1<>0 then Tbyte:=Tbyte or 4;
  240.        If P_Chk2 and 1<>0 then Tbyte:=Tbyte or 2;
  241.        Par_Clc:=Tbyte;
  242.        Z:=0;
  243.        For X:=1 to 7 do begin;
  244.            Z:=Z+(Tbyte and 1);
  245.            Tbyte:=Tbyte shr 1;
  246.        end;
  247.        If (Z and 1)=0 then Par_Clc:=Par_Clc or 1;
  248.        If Par_Chk<>Par_Clc then P_Err:=True;
  249.        Z:=0;
  250.        repeat
  251.              X:=0;
  252.              inc(z);
  253.              repeat
  254.                    inc(x);
  255.                    If (Card_BCD[Z] and $7e=ISO_ALP1[X] and $7e) then begin
  256.                       Card_ASC[Z]:=ISO_ALP2[X];
  257.                       Break;
  258.                    end;
  259.              until X>64;
  260.        until Z=Ch_Count;
  261. end;
  262.  
  263.  
  264. Procedure Writebin;
  265.  
  266. Var X:Integer;
  267.  
  268. Begin;
  269.       writeln;
  270.       For X:=1 to Bitcount do begin;
  271.           If Card_Bin[X]=1 then write('1')
  272.           Else write('0');
  273.       end;
  274.       writeln;
  275. end;
  276.  
  277. Procedure WriteASC;
  278.  
  279. Var    X,Y,Z:Integer;
  280.  
  281. Begin;
  282.        For X:=1 to Ch_Count do begin;
  283.              write(Card_ASC[X]);
  284.        end;
  285.        writeln;
  286.        For X:=1 to Ch_Count do begin;
  287.            If Card_Par[X]=False then begin textcolor(Green);write('*');textcolor(white);end;
  288.            If Card_Par[X]=True then begin textcolor(Red+128);write('*');textcolor(white);end;
  289.        end;
  290.        writeln;
  291.        writeln;
  292.        write('Card Parity Checksum Status: ');
  293.        If P_Err=True then begin textcolor(Red+128);writeln('Error!!!');textcolor(white);end;
  294.        If P_Err=False then begin textcolor(Green+128);writeln('Okay!!!');textcolor(white);end;
  295. end;
  296.  
  297. Begin;
  298.       repeat;
  299.       Clrscr;
  300.       write('Which LPT Port is the Cardreader Connected to? (1-3): ');
  301.       Key:=Readkey;
  302.       Case Key of
  303.       '1':LPT:=$3bc;
  304.       '2':LPT:=$378;
  305.       '3':LPT:=$278;
  306.       else
  307.       LPT:=$000;
  308.       end;
  309.       until LPT<>$000;
  310.       Port[LPT]:=$FF;
  311.       Assign(Fpnt,'CARDDATA.TXT');
  312.       Rewrite(Fpnt);
  313.       Repeat
  314.       ClrScr;
  315.       For X:=1 to 4096 do Card_BIN[X]:=0;
  316.       Textcolor(White+128);
  317.       Writeln('Please Swipe your card through the reader now!');
  318.       Textcolor(White);
  319.       Writeln;
  320.       Writeln;
  321.       Cardwait;
  322.       Bitcount:=Cardread;
  323.       Writebin;
  324.       writeln;
  325.       writeln;
  326.       ISO:=Cardtype;
  327.       If ISO=$1a then ISO_BCD_2_ASC;
  328.       If ISO=$51 then ISO_ALP_2_ASC;
  329.       WriteASC;
  330.       writeln;
  331.       writeln;
  332.       If (P_Err=False) and (Card_BCD[1]=$1a) then begin;
  333.           For X:=1 to Ch_Count do write(Fpnt,Card_ASC[X]);
  334.           Writeln(Fpnt);
  335.        end;
  336.       Assign(Fpnt2,'CARDBIN.TXT');
  337.       Rewrite(Fpnt2);
  338.       For X:=1 to Bitcount do begin;
  339.           If Card_Bin[X]=1 then write(Fpnt2,'1')
  340.           Else write(Fpnt2,'0');
  341.       end;
  342.       writeln(Fpnt2);
  343.       Close(Fpnt2);
  344.       Key:=Readkey;
  345.       Until Key=Chr(27);
  346.       Close(Fpnt);
  347.       Port[LPT]:=$00;
  348. end.